perm filename GOMEZ.SAI[TMP,LCS]1 blob
sn#133872 filedate 1974-07-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "ARMY"
C00004 00003 SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2)
C00009 00004 SUBR COMND
C00013 ENDMK
C⊗;
BEGIN "ARMY"
REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
DEFINE π="3.1415927";
DEFINE SUBR="SIMPLE PROCEDURE";
DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
DEFINE THRU="STEP 1 UNTIL";
DEFINE ⊂="BEGIN";
DEFINE ⊃="END";
EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL W);
INTEGER FRATE,CHR,GRAV,TAKE,IP,X,Y,Z;
REAL NR,NT;STRING STR;
SUBR INIT;
BEGIN "INIT"
MKUNIV;GEODPY;
X ← 0;Y ← 3;Z ← 6;
IP ← 0;TAKE ← 1;
FRATE ← 20;
OUTSTR(" FRATE =");STR ← INCHWL;
IF LENGTH(STR)≠0 THEN FRATE ← INTSCAN(STR,CHR);
NT ← 1.0/FRATE;NR ← NT*π;GRAV ← 32*NT;
END "INIT";
SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2);
BEGIN "ANGL"
REAL ANG;
IF B1<0 THEN B1 ← -B1;
B1 ← A1+LOCOR(B1);
B2 ← A2+LOCOR(B2);
ANG ← ACOS(IX(B1)*IX(B2)+IX(B1+1)*
IX(B2+1)+IX(B1+2)*IX(B2+2));
RETURN(ANG);
END "ANGL";
ISUBR BUMP(INTEGER B1,B2,AX1,AX2;REAL MINA,MAXA,SP);
BEGIN "BUMP"
INTEGER STP;
REAL ANG;
ANG ← SP+ANGL(B1,AX1,B2,AX2);
IF ANG<MINA∨ANG>MAXA THEN STP ← -1
ELSE STP ← 0;
RETURN(STP);
END "BUMP";
ISUBR BEND(REFERENCE INTEGER BAC;INTEGER BD1,BD2,AR1,AR2,AR3;
REAL MN,MX,SP);
BEGIN "BEND"
INTEGER PAST;
REAL RO,RX,RY,RZ,AG;
PAST ← -1;
SP ← NR*SP;RO ← SP;
IF BAC>1 THEN SP ← -SP;
IF BAC>2 THEN ⊂ IF BAC=3 THEN RETURN(PAST);
AG ← ANGL(BD1,AR2,BD2,AR3);
IF AG<AG+SP THEN ⊂ BAC ← 3;RETURN(PAST);⊃;⊃;
IF BUMP(BD1,BD2,AR2,AR3,MN,MX,SP) THEN BEGIN
IF BAC THEN BEGIN
IF BAC>0 THEN ⊂ BAC ← 3;RETURN(PAST);⊃;
RO ← -RO;
END;
END
ELSE PAST ← 0;
RX ← RY ← RZ ← 0;
CASE AR1 OF ⊂ [0] RX ← RO;[3] RY ← RO;[6] RZ ← RO ⊃;
ROTATE(BD1,RX,RY,RZ);
RETURN(PAST);
END "BEND";
SIMPLE REAL PROCEDURE ANGLE(INTEGER B1,A1,N1);
BEGIN "ANGLE"
INTEGER O1;
REAL DIS,AN;
O1 ← LOCOR(B1);DIS ← DISTAN(N1,O1);O1 ← O1+A1;
AN ← ACOS(IX(O1)*((XWC(B1)-XWC(N1))/DIS)+IX(O1+1)*
((YWC(B1)-YWC(N1))/DIS)+IX(O1+2)*((ZWC(B1)-ZWC(N1))/DIS));
RETURN(AN);
END "ANGLE";
SIMPLE REAL PROCEDURE RBDEL(INTEGER B1,A1,B2,A2;REAL DV);
BEGIN "RBDEL"
REAL RB;
RB ← ANGL(B1,A1,B2,A2)/DV;
RETURN(RB);
END "RBDEL";
SIMPLE REAL PROCEDURE RODEL(INTEGER B1,A1,N1;REAL DV);
BEGIN "RODEL"
REAL ROD;
ROD ← ANGLE(B1,A1,N1)/DV;
RETURN(ROD);
END "RODEL";
SIMPLE REAL PROCEDURE TDEL(INTEGER B1,N1;REAL DV);
BEGIN "TDEL"
REAL TD;
TD ← DISTAN(N1,LOCOR(B1))/DV;
RETURN(TD);
END "TDEL";
SUBR PLOP;
BEGIN "PLOP"
IF TAKE>0 THEN ⊂ IF TAKE>1 THEN SHOW2(0,1)
ELSE GEODPY;RETURN;⊃;
IF TAKE<-1 THEN SHOW2(0,1) ELSE GEODPY;
IP ← IP+1;
OUTSTR(" FRAME "&CVS(IP));PLOTO("FRM."&CVS(IP));
END "PLOP";
SUBR COMND;
BEGIN "COMND"
INTEGER LC;
WHILE TRUE DO
BEGIN
LC ← INCHRW;
IF LC="G" THEN GEOMED;
END;
END "COMND";
OUTSTR(12&12&12&12&12);
INIT;
COMND;
END "ARMY";